{M 65520,0,1024}
Uses DOS,CRT;

Type
 str2=string[2];

{*****************************}
{$I data  }  (* Include data *)
{*****************************}
Const
    kkw=19;
    keyw:array[1..kkw] of string[8] =
     {  1      2      3      4        5      6 }
    ('BEGIN','END','BYTE','INTEGER','CHAR','DIM',

     {  7      8       9     10    11   12    13}
     'FILE','INPUT','PRINT','FOR','TO','IF','THEN',

     {14      15     16    17      18     19}
     'OPEN','CLOSE','OF','ERASE','FLUSH','DO');

     kras=12;
                                   { 1   2   3   4}
    tab_ras:array[1..kras] of char=('+','-','*','/',
                                   { 5   6   7   8   9  10}
                                    ',',';','(',')','=',':',
                                   { 11 12 }
                                    '<','>'
                                    );


    dli=20;             { длина имени переменной               }
    dlstr=255;          { длина строковой констаннты           }

    ketabi=100;         { кол-во элементов таблиц              }
    ketabd=100;
    ketabs=100;

    kepr=1024*7;        { максимальный размер обработанной
                         сканером программы (в ликсемах)       }


Var
                   fin:text;          { исходный текст   }
              ifo,ifin:string[64];    { имя файла с исходным текстом }
                                      { и выходным кодом }

           ras,dec,lit:set of char;
                    ch:char;          { текущий символ   }
              fts,fend:boolean;
            gstr,w,str:word;
                    fo:file of byte;  { выходной файл    }
                  r,r2:integer;



                             { ТЕКУЩИЕ : }

                 id_ssl:string[dli];  {имя или служебное слово }
                   dint:string[6];    {числовая константа      }
                   strc:string[dlstr];{строковая константа     }


                             { ТАБЛИЦЫ : }

                 tab_id:array[1..ketabi] of string[dli];
                tab_int:array[1..ketabd] of string[5];
                tab_str:array[1..ketabs] of string[dlstr];

    kstr,kint,kid,kll,i:byte;

           (*  kll=ord(x),x:

                        D - целые числа
                        I - имена
                        S - служебные слова
                        R - разделители
                        L - литералы
           *)

{========================================================================}
                    pr:array[1..kepr] of record
                                          kll:char;
                                          nit:byte;
                                          str:word;
                                         end;
                    up:integer;
{========================================================================}
                    tp:array[1..ketabi] of record
                                            iname:byte;
                                            itype:string[2];
                                             size:word;
                                             addr:word;
                                              res:char;
                                          end;

                    (*  itype:

                          byte - B
                       integer - I
                          char - C
                          dim  - DB  (of byte)
                                 DI  (of integer)
                                 DC  (of char)

                          file - FB
                                 FI
                                 FC
                    *)
                   utp:word;
               adc,adp:word;
{========================================================================}
                    ts:array[1..ketabs] of record
                                            iname:byte;
                                             size:byte;
                                             addr:word;
                                           end;
{========================================================================}
    bh,bmin,bs,bms:word;
              time:real;
             kd,nd:word;
{========================================================================}
Function getkll:char;
BEGIN
 getkll:=pr[up].kll;
END;
{***************************************}
Function getnit:byte;
BEGIN
 getnit:=pr[up].nit;

END;
{***************************************}
Function va:integer;
Var
 z,c:integer;
BEGIN
 val(tab_int[getnit],z,c);
 va:=z;
END;
{***************************************}

Procedure Er(ms:string;ek:word);
BEGIN
    writeln;
    write('Ошибка в строке ',str,' : ',ms);
    halt(ek);

END;

{***************************************}
Procedure nextl;
BEGIN
 gotoxy(1,2);
 write(ifin,'(',str,')');

 up:=up+1;
 if pr[up].str<>0 then
          str:=pr[up].str;

END;
{***************************************}
Procedure Settpname;
BEGIN
{if getnit<=tp[utp-1].iname then
 er('Повторное описание переменной',2);}
 tp[utp].iname:=getnit;

END;
{***************************************}
Procedure Settpnext(itype:str2;size:word;res:char);
BEGIN
 tp[utp].itype:=itype;
 tp[utp].size:=size;
 tp[utp].addr:=adp;
 tp[utp].res:=res;
 adp:=adp+size;
 utp:=utp+1;
END;
{***************************************}
Procedure gendatbyte(d:byte);
BEGIN
  write(fo,d);
END;
{***************************************}
Procedure gendatword(d:word);
var b:byte;
BEGIN
  b:=d mod 256;
  write(fo,b);
  b:=d div 256;
  write(fo,b);
END;
{***************************************}

Procedure gencodbyte(d:byte);
BEGIN
  write(fo,d);
  adc:=adc+1;
END;
{***************************************}
Procedure gencodword(d:word);
var b:byte;
BEGIN
  b:=d mod 256;
  write(fo,b);
  b:=d div 256;
  write(fo,b);
  adc:=adc+2;
END;
{***************************************}

{*******************************}
{$I prscan}  (* Include scaner *)
{*******************************}

{******************************}
{$I arifm}
{******************************}
procedure sop;forward;
{******************************}
Procedure SE(cp:byte);
BEGIN
en:=true;
E;
CASE cp of
 1:{byte}
   begin
    gencodbyte($E8);                {call 22bh}
    gencodword(-(adc+2-$22b));
   end;
 2:{integer plus}
   begin
    gencodbyte($E8);
    gencodword(-(adc+2-$2BD));      {call 2bdh}
   end;
END {CASE}
END;

{***************************************}

{*****************************************************************}
Procedure LET;           {6}
Var
 nm,np:word;
BEGIN
 np:=getnit;

 if tp[getnit].iname=0
  then er('Неизвестная переменная',6);

 case tp[np].itype[1] of
  'I':begin{Int}
         nextl;
          if (getkll<>'R') or (getnit<>10) then
          er('Ожидался разделитель `:`',6);
         nextl;

         if (getkll<>'R') or (getnit<>9) then
          er('Ожидался разделитель `=`',6);
         nextl;
        se(0);
        gencodbyte($A3);gencodword(tp[np].addr); {mov [addr],ax}
      end; {Int}
  'B':begin{Byte}
         nextl;
          if (getkll<>'R') or (getnit<>10) then
          er('Ожидался разделитель `:`',6);
         nextl;

         if (getkll<>'R') or (getnit<>9) then
          er('Ожидался разделитель `=`',6);
         nextl;
        se(1);
        gencodbyte($A2);
        gencodword(tp[np].addr);                {mov [addr],al}
      end; {Byte}
  'C':begin
        nextl;
         if (getkll<>'R') or (getnit<>10) then
         er('Ожидался разделитель `:`',6);
        nextl;

        if (getkll<>'R') or (getnit<>9) then
         er('Ожидался разделитель `=`',6);
        nextl;

       if (getkll<>'L') then
       er('Ожидалась строковая константа',6);
       gencodbyte($A0);gencodword(ts[getnit].addr);   {mov al,[addr]}
       gencodbyte($A2);gencodword(tp[np].addr);       {mov [addr],al}
       nextl;
      end;
  'D':begin{Dim}
                       nm:=getnit;
                       nextl;
                       if getkll<>'R' then er('Ожидался разделитель `(`',4)
                         else if getnit<>7
                           then er('Ожидался разделитель `(`',4)
                            else
                            case tp[nm].itype[2] of
                             'I':begin {DI}

                                  se(2);
         {mov bx,size}            gencodbyte($BB);gencodword(tp[nm].size);
         {call 288h}              gencodbyte($E8);gencodword(-(adc+2-$288));

         {mov bx,2}               gencodbyte($BB);gencodword($0002);
         {mul bx}                 gencodbyte($F7);gencodbyte($E3);
         {mov bx,[addr]}          gencodbyte($BB);gencodword(tp[nm].addr);
         {add bx,ax}              gencodbyte($01);gencodbyte($C3);

         {push bx}                gencodbyte($53);

                                   if (getkll<>'R') or (getnit<>10) then
                                   er('Ожидался разделитель `:`',6);
                                  nextl;

                                  if (getkll<>'R') or (getnit<>9) then
                                   er('Ожидался разделитель `=`',6);
                                  nextl;

                                  se(0);

          {pop bx}                gencodbyte($5B);

          {mov [bx],ax}           gencodbyte($89);gencodbyte($07);

                                 end;  {DI}
                           'B':begin {DB}

                                se(2);
          {mov bx,size}         gencodbyte($BB);gencodword(tp[nm].size);
          {call 288h}           gencodbyte($E8);gencodword(-(adc+2-$288));

          {mov bx,[addr]}       gencodbyte($BB);gencodword(tp[nm].addr);
          {add bx,ax}           gencodbyte($01);gencodbyte($C3);

                {push bx}
                                gencodbyte($53);
                                 if (getkll<>'R') or (getnit<>10) then
                                 er('Ожидался разделитель `:`',6);
                                nextl;

                                if (getkll<>'R') or (getnit<>9) then
                                 er('Ожидался разделитель `=`',6);
                                nextl;
                                se(1);
           {call 22bh}          gencodbyte($E8);gencodword(-(adc+2-$22b));

                {pop bx}        gencodbyte($5B);
           {mov [bx],al}        gencodbyte($88);gencodbyte($07);
                               end;  {DB}
                             'C':begin {DC}

                                   se(2);
             {mov bx,size}         gencodbyte($BB);gencodword(tp[nm].size);
             {call 288h}           gencodbyte($E8);gencodword(-(adc+2-$288));

             {mov bx,[addr]}       gencodbyte($BB);gencodword(tp[nm].addr);
             {add bx,ax}           gencodbyte($01);gencodbyte($C3);

                                 if (getkll<>'R') or (getnit<>10) then
                                 er('Ожидался разделитель `:`',6);
                                nextl;

                                if (getkll<>'R') or (getnit<>9) then
                                 er('Ожидался разделитель `=`',6);
                                nextl;

                                  if (getkll='L') then
                                     begin
                 {mov al,[addr]}      gencodbyte($A0);gencodword(ts[getnit].addr);
                 {mov [bx],al}        gencodbyte($88);gencodbyte($07);
                                     end else
                                  if (getkll='I') and (tp[getnit].itype[1]='C')
                                  then
                                      begin
                 {mov al,[addr]}      gencodbyte($A0);gencodword(tp[getnit].addr);
                 {mov [bx],al}        gencodbyte($88);gencodbyte($07);
                                     end else

                                    er('Ожидалась строковая константа',6);

                                  nextl;

                                 end;  {DC}
                            end;  {case [2]}
      end; {Dim}
 end; {case}

 case getkll of
  'R':case getnit of
       6:begin nextl; end
        else
        er('Ожидался разделитель `;`',6);

      end; {case}
  'S':case getnit of
       11:begin end
       else
        er('Ожидался разделитель `;`',6);
      end; {case}

 end {case}


END;

{*****************************************************************
   <ввод>::=INPUT <список ввода>;

<список ввода>::=[<имя файловой пер.>]<имя переменной>
                      {,<имя переменной>}

{*****************************************************************}
Procedure INPUT;      {4}
Var
 ers,nm:integer;
      d:word;
     nf:word;
BEGIN
 nextl;

 if getkll<>'I' then er('Ожидалось имя переменной',4)
   else if tp[getnit].iname=0 then
      er('Неизвестная переменная',4)
  else
    case tp[getnit].itype[1] of
{-----------------------------------------------------------}
          'F':begin {from file}
                 nf:=getnit;
                 if tp[getnit].res='C' then
                            er('Файл не открыт',4);
                  nextl;
                 if (getkll<>'R') or (getnit<>5)
                     then er('Ожидался разделитель `,`',4);
                  case tp[nf].itype[2] of
                  {---------------------------}
                    'I':begin {FI}
                         repeat
                          nextl;
                          if (getkll<>'I') then
                           er ('Ожидалась переменная целого типа',4);
                          Case tp[getnit].itype[1] of
                           'I':begin {I}
             {mov ah,3Fh}    gencodbyte($B4);gencodbyte($3F);
             {mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,2}      gencodbyte($B9);gencodword($02);
             {mov dx,addr}   gencodbyte($BA);gencodword(tp[getnit].addr);
             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                             nextl;
                               end;  {I}
                         'D':begin  {D}
                            nm:=getnit;
                            nextl;
                            if (getkll<>'R') or (getnit<>7)
                             then er('Ожидался разделитель `(`',4);

                            if tp[nm].itype[2]='I' then

                              begin {DI}

                                  se(2);
           {mov bx,size}          gencodbyte($BB);gencodword(tp[nm].size);
           {call 288h}            gencodbyte($E8);gencodword(-(adc+2-$288));

           {mov bx,2}             gencodbyte($BB);gencodword($0002);
           {mul bx}               gencodbyte($F7);gencodbyte($E3);
           {mov bx,[addr]}        gencodbyte($BB);gencodword(tp[nm].addr);
           {add bx,ax}            gencodbyte($01);gencodbyte($C3);


             {mov dx,bx }    gencodbyte($89);gencodbyte($DA);

           {mov ah,3Fh}      gencodbyte($B4);gencodbyte($3F);
           {mov bx,[addr]}   gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,2}      gencodbyte($B9);gencodword($02);

             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                                 end {DI}

                               else er('Ожидалась переменная типа INTEGER',4);
                               end; {D}
                             else er('Ожидалась переменная типа INTEGER',4);
                          End; {Case}

                          if (getkll<>'R') or ((getnit<>5)
                            and (getnit<>6)) then
                           er('Ожидался разделитель `;` или `,`',4)

                        until (getkll='R') and (getnit=6);
                        end;   {FI}
                  {---------------------------}
                    'B':begin {FB}
                         repeat
                          nextl;
                          if (getkll<>'I') then
                           er ('Ожидалась переменная целого типа',4);
                          Case tp[getnit].itype[1] of
                           'B':begin {B}
             {mov ah,3Fh}    gencodbyte($B4);gencodbyte($3F);
             {mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,1}      gencodbyte($B9);gencodword($01);
             {mov dx,addr}   gencodbyte($BA);gencodword(tp[getnit].addr);
             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                             nextl;
                               end;  {B}
                         'D':begin  {D}
                            nm:=getnit;
                            nextl;
                            if (getkll<>'R') or (getnit<>7)
                             then er('Ожидался разделитель `(`',4);

                            if tp[nm].itype[2]='B' then

                              begin {DB}

                                  se(2);
           {mov bx,size}          gencodbyte($BB);gencodword(tp[nm].size);
           {call 288h}            gencodbyte($E8);gencodword(-(adc+2-$288));

           {mov bx,[addr]}        gencodbyte($BB);gencodword(tp[nm].addr);
           {add bx,ax}            gencodbyte($01);gencodbyte($C3);


             {mov dx,bx }    gencodbyte($89);gencodbyte($DA);

           {mov ah,3Fh}      gencodbyte($B4);gencodbyte($3F);
           {mov bx,[addr]}   gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,1}      gencodbyte($B9);gencodword($01);

             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                                 end {DB}

                               else er('Ожидалась переменная типа BYTE',4);
                               end; {D}
                             else er('Ожидалась переменная типа BYTE',4);
                          End; {Case}

                          if (getkll<>'R') or ((getnit<>5)
                            and (getnit<>6)) then
                           er('Ожидался разделитель `;` или `,`',4)

                         until (getkll='R') and (getnit=6);
                        end;   {FB}
                  {---------------------------}
                    'C':begin {FC}
                         repeat
                          nextl;
                          if (getkll<>'I') then
                           er ('Ожидалась переменная символьного типа',4);
                          Case tp[getnit].itype[1] of
                           'C':begin {C}
             {mov ah,3Fh}    gencodbyte($B4);gencodbyte($3F);
             {mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,1}      gencodbyte($B9);gencodword($01);
             {mov dx,addr}   gencodbyte($BA);gencodword(tp[getnit].addr);
             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                             nextl;
                               end;  {C}
                         'D':begin  {D}
                            nm:=getnit;
                            nextl;
                            if (getkll<>'R') or (getnit<>7)
                             then er('Ожидался разделитель `(`',4);

                            if tp[nm].itype[2]='C' then

                              begin {DC}

                                  se(2);
           {mov bx,size}          gencodbyte($BB);gencodword(tp[nm].size);
           {call 288h}            gencodbyte($E8);gencodword(-(adc+2-$288));

           {mov bx,[addr]}        gencodbyte($BB);gencodword(tp[nm].addr);
           {add bx,ax}            gencodbyte($01);gencodbyte($C3);


             {mov dx,bx }    gencodbyte($89);gencodbyte($DA);

           {mov ah,3Fh}      gencodbyte($B4);gencodbyte($3F);
           {mov bx,[addr]}   gencodbyte($8B);gencodbyte($1E);
                             gencodword(tp[nf].addr);
             {mov cx,1}      gencodbyte($B9);gencodword($01);

             {int 21h}       gencodbyte($CD);gencodbyte($21);
             {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
             {call 392h}     gencodbyte($E8);gencodword(-(adc+2-$392));
                                 end {DC}

                               else er('Ожидалась переменная символьного типа ',4);
                               end; {D}
                             else er('Ожидалась переменная символьного типа ',4);
                          End; {Case}


                          if (getkll<>'R') or ((getnit<>5)
                            and (getnit<>6)) then
                           er('Ожидался разделитель `;` или `,`',4)

                         until (getkll='R') and (getnit=6);

                        end;   {FC}
                  {---------------------------}
                   end; {case }
               end;  {from file}
{-----------------------------------------------------------}
'C','B','I','D':
              repeat {from display}

                case tp[getnit].itype[1] of
                  'I':begin
    {call 15dh}        gencodbyte($E8);gencodword(-(adc+2-$15D));
    {mov [addr],ax}    gencodbyte($A3);gencodword(tp[getnit].addr);
                       nextl;
                      end;
                  'B':begin
    {call 15dh}        gencodbyte($E8);gencodword(-(adc+2-$15D));
    {call 22bh}        gencodbyte($E8);gencodword(-(adc+2-$22b));
    {mov [addr],al}    gencodbyte($A2);gencodword(tp[getnit].addr);
                       nextl;
                      end;
                  'C':begin
    {call 27dh}        gencodbyte($E8);gencodword(-(adc+2-$27D));
    {mov [addr],al}    gencodbyte($A2);gencodword(tp[getnit].addr);
                       nextl;
                      end;

                  'D':begin  {D}
                       nm:=getnit;
                       nextl;
                       if getkll<>'R' then er('Ожидался разделитель `(`',4)
                         else if getnit<>7
                           then er('Ожидался разделитель `(`',4)
                            else
                            case tp[nm].itype[2] of
                             'I':begin {DI}

                                  se(2);
           {mov bx,size}          gencodbyte($BB);gencodword(tp[nm].size);
           {call 288h}            gencodbyte($E8);gencodword(-(adc+2-$288));

           {mov bx,2}             gencodbyte($BB);gencodword($0002);
           {mul bx}               gencodbyte($F7);gencodbyte($E3);
           {mov bx,[addr]}        gencodbyte($BB);gencodword(tp[nm].addr);
           {add bx,ax}            gencodbyte($01);gencodbyte($C3);

            {push bx}             gencodbyte($53);

            {call 15d}            gencodbyte($E8);
                                  gencodword(-(adc+2-$15D));

            {pop bx}              gencodbyte($5B);

            {mov [bx],ax}         gencodbyte($89);gencodbyte($07);

                                 end;  {DI}
                           'B':begin {DB}

                                se(2);
               {mov bx,size}    gencodbyte($BB);gencodword(tp[nm].size);
               {call 288h}      gencodbyte($E8);gencodword(-(adc+2-$288));

               {mov bx,[addr]}  gencodbyte($BB);gencodword(tp[nm].addr);
               {add bx,ax}      gencodbyte($01);gencodbyte($C3);

                {push bx}
                                gencodbyte($53);

              {call 15dh}       gencodbyte($E8);
                                gencodword(-(adc+2-$15D));
              {call 22bh}       gencodbyte($E8);gencodword(-(adc+2-$22b));

                {pop bx}
                                gencodbyte($5B);
              {mov [bx],al}     gencodbyte($88);gencodbyte($07);


                               end;  {DB}


                             'C':begin {DC}

                                   se(2);
              {mov bx,size}        gencodbyte($BB);gencodword(tp[nm].size);
              {call 288h}          gencodbyte($E8);gencodword(-(adc+2-$288));

              {mov bx,[addr]}      gencodbyte($BB);gencodword(tp[nm].addr);
              {add bx,ax}          gencodbyte($01);gencodbyte($C3);

              {call 27dh}          gencodbyte($E8);
                                   gencodword(-(adc+2-$27D));
              {mov [bx],al}        gencodbyte($88);gencodbyte($07);

                                 end;  {DC}
                            end;  {case [2]}
                      end; {D}
                end; {case [1]}

  {call 271h}    gencodbyte($E8);
                 gencodword(-(adc+2-$271));

                if getkll<>'R' then
                    er('Ожидался разделитель `;` или `,`',4)
                   else
                    case getnit of
                     6:begin end;
                     5:begin   {,}

                        nextl;
                        if getkll<>'I' then
                          er('Ожидалось имя переменной',4)
                         else
                          if tp[getnit].iname=0 then
                                er('Неизвестная переменная',4)

                       end    {,}
                         else er('Ожидался разделитель `;` или `,`',4)
                    end {case}
             until (getkll='R') and (getnit=6); {to display}

    end;  {case}
 nextl;
END;
(*****************************************************************)
Procedure PRINT;   {4}
Var
 nm,ers:integer;
   nf,d:word;
BEGIN
 nextl;
 if (getkll='I') and (tp[getnit].itype[1]='F')
  then
  BEGIN                        {to file}
   if tp[getnit].res='C' then er('Файл не открыт',4);
      nf:=getnit;
      nextl;
      if (getkll<>'R') or (getnit<>5)
       then er('Ожидался разделитель `,`',4);

   Case tp[nf].itype[2] of
    'C':begin {FL}
         repeat
          nextl;
          case getkll of {case}
           'L':begin{L}
{mov ah,40h}    gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,size}   gencodbyte($B9);gencodword(ts[getnit].size-1);
{mov dx,addr}   gencodbyte($BA);gencodword(ts[getnit].addr);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                nextl;
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end; {L}
           'I':begin{I}
             case tp[getnit].itype[1] of {case}
                'D': case tp[getnit].itype[2] of  {dc}
                            'C':begin
                                    nm:=getnit;
                                    nextl;
                                    if (getkll<>'R') or (getnit<>7)
                                    then
                                    er('Ожидался разделитель `(`',4);
                                    se(2);
              {mov bx,size}        gencodbyte($BB);gencodword(tp[nm].size);
              {call 288h}          gencodbyte($E8);gencodword(-(adc+2-$288));
              {mov bx,[addr]}      gencodbyte($BB);gencodword(tp[nm].addr);
              {add bx,ax}          gencodbyte($01);gencodbyte($C3);
              {mov dx,bx}          gencodbyte($89);gencodbyte($DA);
                   {mov ah,40h}    gencodbyte($B4);gencodbyte($40);
                   {mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                                   gencodword(tp[nf].addr);
                   {mov cx,1}      gencodbyte($B9);gencodword($01);
                   {int 21h}       gencodbyte($CD);gencodbyte($21);
                   {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
                   {call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                               end
                       else
                         er('Ожидалась символьная константа или переменная',4);
                   end;                          {dc}
                'C':begin{C}
     {mov ah,40h}    gencodbyte($B4);gencodbyte($40);
     {mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);gencodword(tp[nf].addr);
     {mov cx,1}      gencodbyte($B9);gencodword($01);
     {mov dx,addr}   gencodbyte($BA);gencodword(tp[getnit].addr);
     {int 21h}       gencodbyte($CD);gencodbyte($21);
     {jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
     {call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                     nextl;
                     if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                            then er('Ожидался разделитель `,` или `;` ',4);
                    end; {C}
                       else
                         er('Ожидалась символьная константа или переменная',4);

                end; {case}

                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end  {I}
                 else er('Ожидалась символьная константа или переменная',4);

          end;           {case}
         until (getkll='R') and (getnit=6);
        end;  {FL}
    'B':begin {FB}
         repeat
          nextl;
          case getkll of
            'D':begin {D}
                se(1);
{mov [da],al}   gencodbyte($A2);gencodword($039C);
{mov ah,40h}    gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,1}      gencodbyte($B9);gencodword($01);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {D}
            'R':begin {R}
                if (getnit<>2) or (getnit<>7)
                 then er('Ожидалась целая константа или переменная',4);
                se(1);
{mov [da],al}   gencodbyte($A2);gencodword($039C);
{mov ah,40h}    gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,1}      gencodbyte($B9);gencodword($01);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {R}
            'I':begin {I}
                if ((tp[getnit].itype[1]='D') and
                   (tp[getnit].itype[2]='C')) or
                    (tp[getnit].itype[1]='C')
                 then er('Ожидалась целая константа или переменная',4);

                se(1);
{mov [da],al}   gencodbyte($A2);gencodword($039C);
{mov ah,40h}    gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,1}      gencodbyte($B9);gencodword($01);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {I}


            else er('Ожидалась целая константа или переменная',4);
          end; {case getkll of}
         until (getkll='R') and (getnit=6);
        end;  {FB}

    'I':begin {FI}
         repeat
          nextl;
          case getkll of
            'D':begin {D}
                se(0);
{mov [da],ax}   gencodbyte($A3);gencodword($039C);
{mov ah,40h}    gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,2}      gencodbyte($B9);gencodword($02);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {D}
            'R':begin {R}
                if (getnit<>2) and (getnit<>7)
                 then er('Ожидалась целая константа или переменная',4);
                se(0);
{mov [da],ax}   gencodbyte($A3);gencodword($039C);
{mov ah,40h}   gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,2}      gencodbyte($B9);gencodword($02);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {R}
            'I':begin {I}
                if ((tp[getnit].itype[1]='D') and
                   (tp[getnit].itype[2]='C')) or
                    (tp[getnit].itype[1]='C')
                 then er('Ожидалась целая константа или переменная',4);

                se(0);
{mov [da],ax}   gencodbyte($A3);gencodword($039C);
{mov ah,40h}   gencodbyte($B4);gencodbyte($40);
{mov bx,[addr]} gencodbyte($8B);gencodbyte($1E);
                gencodword(tp[nf].addr);
{mov cx,2}      gencodbyte($B9);gencodword($02);
{mov dx,da  }   gencodbyte($BA);gencodword($039C);
{int 21h}       gencodbyte($CD);gencodbyte($21);
{jnc +3}        gencodbyte($73);gencodbyte($3);  {I/O error ?}
{call 388h}     gencodbyte($E8);gencodword(-(adc+2-$388));
                if (getkll<>'R') or ((getnit<>6) and (getnit<>5))
                       then er('Ожидался разделитель `,` или `;` ',4);
               end;  {I}

            else er('Ожидалась целая константа или переменная',4);
          end; {case getkll of}
         until (getkll='R') and (getnit=6);
        end;  {FI}

    End;                 {case}
   END                        {to file}

 else
 Begin                              {to display}
  Repeat
   case getkll of
    'L':begin {L}
         gencodbyte($BA);gencodword(ts[getnit].addr); {mov dx,addr}
         gencodbyte($B4);gencodbyte($09);             {mov ah,9}
         gencodbyte($CD);gencodbyte($21);             {int 21h}
         nextl;
        end;  {L}

    'D':begin {D}
         se(0);
         gencodbyte($E8);gencodword(-(adc+2-$10A));    {call 10ah}
        end;  {D}
    'R':begin {R}
        if getnit=6 then
                      begin
                        gencodbyte($E8);               {call 271h}
                        gencodword(-(adc+2-$271));
                        nextl;
                        exit;
                      end;
        if (getnit<>7) and (getnit<>2)
         then er('Неверный элемент вывода',4);
         se(0);
         gencodbyte($E8);gencodword(-(adc+2-$10A));    {call 10ah}
        end;  {R}
    'I':begin {I}
         if tp[getnit].iname=0
             then er('Неизвестная переменная',4);

         case tp[getnit].itype[1] of
      'I','B','D':begin
                  if tp[getnit].itype[2]<>'C'
                  then
                   begin
                    se(0);
{call 10ah}         gencodbyte($E8);gencodword(-(adc+2-$10A));
                   end
                   else
                    begin
                     nm:=getnit;
                     se(1);
{mov ah,0eh}         gencodbyte($B4);gencodbyte($0E);
{int 10h}            gencodbyte($CD);gencodbyte($10);
                    end;

                  end;
              'C':begin
{mov ah,0eh}       gencodbyte($B4);gencodbyte($0E);
{mov al,[addr] }   gencodbyte($A0);gencodword(tp[getnit].addr);
{int 10h}          gencodbyte($CD);gencodbyte($10);
                   nextl;
                  end;
                 else er('Неверный элемент вывода',4);

                end; {case}
        end;  {I}

         else er('Неверный элемент вывода',4);
   end;{case getkll}

   if getkll<>'R' then
          er('Ожидался разделитель `;` или `,`',4)
                   else
                    case getnit of
                     6:begin end;
                     5:begin   {,}
                        nextl;
                       end     {,}
                      else
                      er('Ожидался разделитель `;` или `,`',4)
                    end; {case}

  Until (getkll='R') and (getnit=6);

 End;                                  {to display}
 nextl;
END;
(*****************************************************************)
Procedure CIKL;                         {7}
Var
         pf:word;
    af1,af2:word;
fpos1,fpos2:longint;
BEGIN
 nextl;
 pf:=getnit;
 if getkll<>'I' then
  er('Ожидался оператор присваевания',7);
 let;
 af1:=adc;

 if (getkll<>'S') or (getnit<>11)
  then
  er('Ожидалось ключевое слово TO',7);
 nextl;

 case tp[pf].itype[1] of
  'I':begin
       se(0);
       gencodbyte($8B);gencodbyte($1E);    {mov bx,[addr]}
       gencodword(tp[pf].addr);
      end;
  'B':begin
       se(1);
       gencodbyte($8A);gencodbyte($1E);    {mov bl,[addr]}
       gencodword(tp[pf].addr);
      end
    else
     er('Ожидалась переменная простого целого типа',7);
 end; { case tp[pf].itype }

 if (getkll<>'S') or (getnit<>19)
  then
  er('Ожидалось ключевое слово DO',7);
 nextl;

 gencodbyte($39);gencodbyte($C3);             {cmp bx,ax}
 gencodbyte($7E);gencodbyte($03);             {jng operator}


 {----------------------}
  gencodbyte($E9);                            {jmp end of cikle}
  af2:=adc;
  fpos1:=filepos(fo);
  gencodword(0);   {будущий
                    переход на конец
                    цикла            }

 {----------------------}
    {тело цикла}
 {++++++++++++++++++++++}
   sop;
 {++++++++++++++++++++++}
  case tp[pf].itype[1] of
  'I':begin
       gencodbyte($8B);gencodbyte($1E);    {mov bx,[addr]}
       gencodword(tp[pf].addr);
       gencodbyte($43);                    {inc bx }
       gencodbyte($89);gencodbyte($1E);    {mov [addr],bx}
       gencodword(tp[pf].addr);
      end;
  'B':begin
       gencodbyte($8A);gencodbyte($1E);    {mov bl,[addr]}
       gencodword(tp[pf].addr);
       gencodbyte($43);                    {inc bx }
       gencodbyte($88);gencodbyte($1E);    {mov [addr],bl}
       gencodword(tp[pf].addr);
      end
 end; { case tp[pf].itype }

 gencodbyte($E9);gencodword(-(adc-af1+2));    {jmp begin of cikle}

 fpos2:=filepos(fo);
 seek(fo,fpos1);

 gendatword(adc-af2-2);    {<-insert to jmp 0000}  { end of cikle}
 seek(fo,fpos2);

END;
(*****************************************************************)
Procedure USL;                 {8}
Var
nr1,nr2:word;
au:word;
fpos1,fpos2:longint;
{---------------}
BEGIN
 nr2:=0;

 nextl;

 se(0);
 gencodbyte($50);                  {push ax}

 if (getkll<>'R') or
 (not(getnit in [9,11,12]))
  then er('Ожидалась операция отношения',8);
  nr1:=getnit;
  nextl;

 if (getkll='R') and
 (getnit in [9,11,12])
  then
  begin
   nr2:=getnit;
   nextl;
  end;

 se(0);
 gencodbyte($5B);                    {pop bx}
 gencodbyte($39);gencodbyte($D8);    {cmp ax,bx}

 if (getkll<>'S') or (getnit<>13)
  then er('Ожидалось ключевое слово THEN',8);

 nextl;

 if nr2=0
 then
 case nr1 of
  9:begin {=}
     gencodbyte($74);                {je}
    end;
 12:begin {>}
     gencodbyte($7C);                {jg}
    end;
 11:begin {<}
     gencodbyte($7F);                {jl}
    end;
 end { case nr1 of}
 else
 case nr1 of
  9:{=}
     case nr2 of
      12:begin  {=>}
          gencodbyte($7E);            {jnl}
         end;
      11:begin  {=<}                  {jle}
          gencodbyte($7D);
         end;
       else er('Ошибка в операторе сравнения',8);
     end;
  11:{<}
     case nr2 of
      12:begin  {<>}
          gencodbyte($75);             {jne}
         end;
       9:begin  {<=}                   {jle}
          gencodbyte($7D);
         end;
       else er('Ошибка в операторе сравнения',8);
     end;
  12:{>}
     case nr2 of
      11:begin {><}
          gencodbyte($75);              {jne}
         end;
       9:begin {>=}
          gencodbyte($7E);              {jnl}
         end;
        else er('Ошибка в операторе сравнения',8);
     end;
 end; { case nr1 of with nr2}

 gencodbyte($3);                         {+3}
 {----------------------}
  gencodbyte($E9);                       {jmp end of operator}
  au:=adc;
  fpos1:=filepos(fo);
  gencodword(0);   {будущий
                    переход на конец
                    условия            }

 {++++++++++++++++++++++}
   sop;
 {++++++++++++++++++++++}

  fpos2:=filepos(fo);
  seek(fo,fpos1);

  gendatword(adc-au-2);
  seek(fo,fpos2);

END;
(*****************************************************************)
Procedure OPEN;     {9}
Var
si,nf:word;
BEGIN
 nextl;

 if (getkll<>'I') and (tp[getnit].itype[1]<>'F')
  then er('Ожидалась файловая переменная',9);
  nf:=getnit;

 if tp[getnit].res='O' then
  er('Файловая переменная уже связанна с файлом',9);
 nextl;
 if (getkll<>'R') and (getnit<>5)
  then er('Ожидался разделитель `,`',9);
 nextl;
 if (getkll<>'L')
  then er('Ожидалось имя файла ',9);
  si:=getnit;
 nextl;

 case getkll of
   'R':BEGIN
       case getnit of
        6:begin  {no erase}
         gencodbyte($B4);gencodbyte($5B);                 {mov ah,5bh}
         gencodbyte($B9);gencodword($00);                 {mov cx,0}
         gencodbyte($BA);gencodword(ts[si].addr);     {mov dx,addr}

         gencodbyte($BE);gencodword(ts[si].addr);     {mov si,adr}
         gencodbyte($BB);gencodword(ts[si].size-1);   {mov bx,size-1}
         gencodbyte($C6);gencodword($00);                 {mov [si+bx],0}

         gencodbyte($CD);gencodbyte($21);                 {int 21h}

         gencodbyte($73);gencodbyte(17); {error ?}        {jnc +3}
         gencodbyte($E8);gencodword(-(adc+2-$2EE));       {call 2eeh}

         gencodbyte($B4);gencodbyte($3D);                 {mov ah,3d}
         gencodbyte($B0);gencodbyte($2);                  {mov al,2}
         gencodbyte($BA);gencodword(ts[si].addr);     {mov dx,addr}

         gencodbyte($CD);gencodbyte($21);                 {int 21h}
         gencodbyte($73);gencodbyte($3); {error ?}        {jnc +3}
         gencodbyte($E8);gencodword(-(adc+2-$2EE));       {call 2eeh}

         gencodbyte($A3);gencodword(tp[nf].addr);         {mov [addr],ax}
       end;
          5:begin {erase}
             nextl;
             if (getkll<>'S') and (getnit<>18)
               then er('Ожидалось ключевое слово ERASE',9);
         gencodbyte($BE);gencodword(ts[si].addr);     {mov si,adr}
         gencodbyte($BB);gencodword(ts[si].size-1);   {mov bx,size-1}
         gencodbyte($C6);gencodword($00);             {mov [si+bx],0}

         gencodbyte($B4);gencodbyte($3C);                 {mov ah,3C}
         gencodbyte($B9);gencodword($00);                 {mov cx,0}
         gencodbyte($BA);gencodword(ts[si].addr);         {mov dx,addr}

         gencodbyte($CD);gencodbyte($21);                 {int 21h}
         gencodbyte($73);gencodbyte($3); {error ?}        {jnc +3}
         gencodbyte($E8);gencodword(-(adc+2-$2EE));       {call 2eeh}

         gencodbyte($A3);gencodword(tp[nf].addr);         {mov [addr],ax}
             nextl;
            if (getkll<>'R') and (getnit<>6)
              then er('Ожидался разделитель `;` ',9);
            end;  {erase}
        end; {case}
       END;
    else
       er('Ожидался разделитель `;` или `,` ',9);

   end; {case}
   nextl;


 tp[nf].res:='O';

END;
(*****************************************************************)
Procedure FCLOSE;                 {9}
BEGIN
 nextl;
 if (getkll<>'I') and (tp[getnit].itype[1]<>'F')
  then er('Ожидалась файловая переменная',9);

  if tp[getnit].res='C' then er('Файл не открыт',9);

 gencodbyte($8B);gencodbyte($1E);                  {mov bx,[addr]}
 gencodword(tp[getnit].addr);
 gencodbyte($B4);gencodbyte($3E);                  {mov  ah,3eh}
 gencodbyte($CD);gencodbyte($21);                  {int 21h}

 tp[getnit].res:='C';
  nextl;
 if (getkll<>'R') and (getnit<>6)
  then er('Ожидался разделитель `;`',9);
  nextl;
END;
{***********************************}
Procedure FLUSH;       {10}
BEGIN
 nextl;
 if (getkll<>'I') and (tp[getnit].itype[1]<>'F')
  then er('Ожидалась файловая переменная',10);

 if tp[getnit].res='C' then er('Файл не открыт',10);

 gencodbyte($8B);gencodbyte($1E);                  {mov bx,[addr]}
 gencodword(tp[getnit].addr);
 gencodbyte($B4);gencodbyte($68);                  {mov  ah,3eh}
 gencodbyte($CD);gencodbyte($21);                  {int 21h}

  nextl;
 if (getkll<>'R') and (getnit<>6)
  then er('Ожидался разделитель `;`',9);
  nextl;
END;
(*****************************************************************)
Procedure op;               {3}
BEGIN
  case getkll of
  'I':let;

  'S':case getnit of
       1:sop;
       2:begin end;
       8:input;
       9:print;
      10:cikl;
      12:usl;
      14:open;
      15:fclose;
      18:flush;
       else er('Неверное ключевое слово',3);
      end {case}

    else er('Ожидался оператор',3);
 end; {case}
END;


(*****************************************************************
                        анализ правила:
         <составной операторов>::=BEGIN {<оператор>} END
******************************************************************)
procedure sop;
BEGIN

if (getkll='S') and (getnit=1)

 then
Begin
  nextl;
  repeat
   if (getkll='S') and (getnit=2)
    then begin end
     else
       op;
  until ((getkll='S') and (getnit=2)) ;
  nextl;
End

 else op;

END;

{*******************************}
{$I opis}
{*******************************}

{*************************************************************
                      анализ правила:
   <программа>::=[<описяние переменных>]<составной оператор>
 *************************************************************}
procedure prog;
BEGIN

 opis;     { раздел описаний }

 adc:=adp; { конец данных - начало кода }

 sop;      { составной оператор }

 gencodbyte($CD);   {int 20h}
 gencodbyte($20);

END;
{==============================================================}
BEGIN

 clrscr;
 if paramcount=0 then
  begin
    Write('Ведите имя исходного файла:');
    readln(ifin);
  end
    else ifin:=paramstr(1);
 for i:=1 to ketabi do
   begin
    tp[i].iname:=0;
    tp[i].size:=0;
   end;

 i:=1;
 ifo:='';

 if paramcount<2 then
                  Begin
                   repeat
                    ifo:=ifo+ifin[i];
                    i:=i+1;
                   until (ifin[i]='.') or (i=length(ifin));
                    ifo:=ifo+'.com'
                  End {no param[2]}

    else ifo:=paramstr(2);

 gettime(bh,bmin,bs,bms);
 time:=bs+bms/100;

  assign(fin,ifin);
  reset(fin);

  assign(fo,ifo);
  rewrite(fo);

  scan;

  up:=0; str:=1;
  nextl; adp:=$104+80+215+67+11+15+53+49+60+114+3;
  nd:=adp;
  kd:=7+9+84+40+3+4+38+33+44+84+3;
  utp:=1;
  prog;

  gettime(bh,bmin,bs,bms);
  time:=bs+bms/100-time;

  writeln;
  writeln('Скомпилированно ',str,' строк');
  writeln('Данные:',adp-nd+kd,' байт');
  writeln('Код:',adc-adp+nd-$100-kd,' байт');
  writeln('Время компиляции ',time:2:2,' секунд');
  writeln;

END.